home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / dassl / ddawts.f < prev    next >
Text File  |  1996-07-19  |  1KB  |  43 lines
  1.       SUBROUTINE DDAWTS (NEQ, IWT, RTOL, ATOL, Y, WT, RPAR, IPAR)
  2. C***BEGIN PROLOGUE  DDAWTS
  3. C***SUBSIDIARY
  4. C***PURPOSE  Set error weight vector for DDASSL.
  5. C***LIBRARY   SLATEC (DASSL)
  6. C***TYPE      DOUBLE PRECISION (SDAWTS-S, DDAWTS-D)
  7. C***AUTHOR  PETZOLD, LINDA R., (LLNL)
  8. C***DESCRIPTION
  9. C-----------------------------------------------------------------------
  10. C     THIS SUBROUTINE SETS THE ERROR WEIGHT VECTOR
  11. C     WT ACCORDING TO WT(I)=RTOL(I)*ABS(Y(I))+ATOL(I),
  12. C     I=1,-,N.
  13. C     RTOL AND ATOL ARE SCALARS IF IWT = 0,
  14. C     AND VECTORS IF IWT = 1.
  15. C-----------------------------------------------------------------------
  16. C***ROUTINES CALLED  (NONE)
  17. C***REVISION HISTORY  (YYMMDD)
  18. C   830315  DATE WRITTEN
  19. C   901009  Finished conversion to SLATEC 4.0 format (F.N.Fritsch)
  20. C   901019  Merged changes made by C. Ulrich with SLATEC 4.0 format.
  21. C   901026  Added explicit declarations for all variables and minor
  22. C           cosmetic changes to prologue.  (FNF)
  23. C***END PROLOGUE  DDAWTS
  24. C
  25.       INTEGER  NEQ, IWT, IPAR(*)
  26.       DOUBLE PRECISION  RTOL(*), ATOL(*), Y(*), WT(*), RPAR(*)
  27. C
  28.       INTEGER  I
  29.       DOUBLE PRECISION  ATOLI, RTOLI
  30. C
  31. C***FIRST EXECUTABLE STATEMENT  DDAWTS
  32.       RTOLI=RTOL(1)
  33.       ATOLI=ATOL(1)
  34.       DO 20 I=1,NEQ
  35.          IF (IWT .EQ.0) GO TO 10
  36.            RTOLI=RTOL(I)
  37.            ATOLI=ATOL(I)
  38. 10         WT(I)=RTOLI*ABS(Y(I))+ATOLI
  39. 20         CONTINUE
  40.       RETURN
  41. C-----------END OF SUBROUTINE DDAWTS------------------------------------
  42.       END
  43.